Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/editgr/winfin.frm

Text File | 1995-05-08 | 13KB | 440 lines

VERSION 2.00
Begin Form MainForm
   BackColor       =   &H00FFFFFF&
   Caption         =   "Edit Grid Demo"
   ClientHeight    =   4335
   ClientLeft      =   360
   ClientTop       =   1695
   ClientWidth     =   6990
   Height          =   5025
   Icon            =   WINFIN.FRX:0000
   Left            =   300
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   4335
   ScaleWidth      =   6990
   Tag             =   "It's just me, the form"
   Top             =   1065
   Width           =   7110
   Begin PictureBox LowerPanel
      BackColor       =   &H000000FF&
      Height          =   1000
      Left            =   0
      ScaleHeight     =   975
      ScaleWidth      =   975
      TabIndex        =   0
      Top             =   0
      Width           =   1000
      Begin PictureBox InnerLowerPanel
         BackColor       =   &H000000FF&
         Height          =   1000
         Left            =   0
         ScaleHeight     =   975
         ScaleWidth      =   975
         TabIndex        =   1
         Top             =   0
         Width           =   1000
      End
   End
   Begin PictureBox TopPanel
      BackColor       =   &H000000FF&
      Height          =   1000
      Left            =   0
      ScaleHeight     =   975
      ScaleWidth      =   975
      TabIndex        =   2
      Top             =   0
      Width           =   1000
      Begin PictureBox EditPanel
         BackColor       =   &H000000FF&
         Height          =   1000
         Left            =   0
         ScaleHeight     =   975
         ScaleWidth      =   975
         TabIndex        =   3
         Top             =   0
         Width           =   1000
         Begin TextBox EditCell
            Alignment       =   1  'Right Justify
            BorderStyle     =   0  'None
            Height          =   240
            Left            =   30
            TabIndex        =   5
            Top             =   60
            Width           =   1545
         End
      End
   End
   Begin PictureBox Grid1
      BackColor       =   &H000000FF&
      Height          =   1000
      Left            =   0
      ScaleHeight     =   975
      ScaleWidth      =   975
      TabIndex        =   4
      Top             =   0
      Width           =   1000
   End
   Begin Menu mnuFileMenu
      Caption         =   "&File"
      Begin Menu mnuBegin
         Caption         =   "&Begin the demo"
      End
      Begin Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
End
'------------------------------------------------------------
'This small VB program demonstrates a method of making the
'VB GRID.VBX editable.  I've spent some time getting ideas
'from various sources--some are even my own.  This program
'is dedicated to all the people that have helped me via
'CompuServe and America Online.
'
'You may cut & paste this code however you want.  I hope
'that you find it useful.  It may not be all that optimized.
'Also, I didn't spend too much time adding comments.
'
'I ask nothing more than that if you find this program useful,
'drop me a line and let me know.  I can be reached at:
'CompuServe: 76470, 3423
'America Online: Seattleite
'-------------------------------------------------------------
Option Explicit     'This is a good idea

Dim SaveData$
Dim SaveEditRow%
Dim SaveEditCol%
Dim EntryInProgress%

Const Fmt$ = "#,##0"
Const KEY_ESCAPE = &H1B
Const KEY_LEFT = &H25
Const KEY_UP = &H26
Const KEY_RIGHT = &H27
Const KEY_DOWN = &H28
Const KEY_F2 = &H71
Const KEY_F9 = &H78

Sub EditCell_Change ()
    'Echoes the contents of the editcell into the grid cell
    'If a user clicks on a new cell the if/then prevents the cell from being blanked
    If Grid1.Col = SaveEditCol% And Grid1.Row = SaveEditRow% And EntryInProgress% Then
    Grid1.Text = EditCell.Text
    End If
End Sub

Sub EditCell_KeyDown (KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
    Case 13, KEY_DOWN    ' Enter key, down arrow
        'You may want to have an "auto advance" option to
        'decide if an Enter moves the cursor down.
        'This demo just does it.
        KeyCode = 0
        ProcessEditCellEntry (KEY_DOWN)
    Case KEY_UP
        'Test to see if the cursor is at the end of the entry.
        'not so necessary for KEY_UP, but... what the heck.
        If EditCell.SelStart = Len(EditCell.Text) Then
        KeyCode = 0
        ProcessEditCellEntry (KEY_UP)
        End If
    Case KEY_RIGHT
        'Test to see if the cursor is at the end of the entry.
        If EditCell.SelStart = Len(EditCell.Text) Then
        KeyCode = 0
        ProcessEditCellEntry (KEY_RIGHT)
        End If
    Case KEY_LEFT
        'Test to see if the cursor is at the beginning of the entry.
        If EditCell.SelStart = 0 Then
        KeyCode = 0
        ProcessEditCellEntry (KEY_LEFT)
        End If
    End Select
End Sub

Sub EditCell_KeyPress (KeyAscii As Integer)
    Select Case KeyAscii
    Case 13    ' Enter key
        KeyAscii = 0
    Case KEY_ESCAPE
        Grid1.Text = SaveData$   'Abandon the edit
        SaveData$ = ""
        EntryInProgress% = False
        EditCell.Text = ""       'Necessary to keep the ProcessEditCellEntry from not kicking in
        EditPanel.Visible = False
        KeyAscii = 0
    Case 42, 43, 45, 46, 47, 48 To 57, 8 '*, +, -, ., /, 0 thru 9, and BACKSPACE
        'These are okay
        'My app only wants to have numbers entered, if you want
        'the ability to handle more than that, expand the case statement.
        '...or just take anything with a case else.
    Case Else
        'The character was something undesirable... make it go away.
        KeyAscii = 0
    End Select
End Sub

Sub EditCell_LostFocus ()
    Dim TempRow%
    Dim TempCol%

    'Put the data back when the user clicks on another cell
    EntryInProgress% = False
    If EditCell.Text <> "" Then ProcessEditCellEntry (0)
End Sub

Function Evaluate# (EditText$, ErrCode)
    Dim Position%
    Dim Operation%
    Dim RightVal#
    Dim LeftVal#
    Dim Balance#
    Dim FirstFlag%

    'My thanks to Ethan Winer for this section of code
    'It is mostly adapted from an article by him
    For Position% = 1 To Len(EditText$)
    Operation% = InStr("+-*/", Mid$(EditText$, Position%, 1))
    If Operation% Then
        LeftVal# = Val(EditText$)
        If FirstFlag% Then LeftVal# = Balance#
        If FirstFlag% = False Then
        FirstFlag% = True
        Balance# = 0
        End If
        RightVal# = Val(Mid$(EditText$, Position% + 1))

        Select Case Operation%
        Case 1  'addition
            If Position% > 1 Then
            Balance# = LeftVal# + RightVal#
            Else
            Balance# = LeftVal#
            End If
        Case 2  'subtraction
            If Position% > 1 Then
            Balance# = LeftVal# - RightVal#
            Else
            Balance# = LeftVal#
            End If
        Case 3  'multiplication
            Balance# = LeftVal# * RightVal#
        Case 4  'division
            If RightVal# = 0# Then
            ErrCode = 3
            Exit Function
            End If
            Balance# = LeftVal# / RightVal#
        End Select
    End If
    Next Position%
    If FirstFlag% = False Then Balance# = Val(EditText$)
    Evaluate# = Balance#    'Return function result
End Function

Sub Form_Resize ()
    If WindowState <> 1 Then
    If MainForm.Width < 6580 Then MainForm.Width = 6580     'Minimum sizes
    If MainForm.Height < 3405 Then MainForm.Height = 3405
    TopPanel.Top = 0
    TopPanel.Left = 0
    TopPanel.Width = ScaleWidth
    LowerPanel.Top = ScaleHeight - LowerPanel.Height
    LowerPanel.Left = 0
    LowerPanel.Width = ScaleWidth
    InnerLowerPanel.Width = LowerPanel.Width - 630
    Grid1.Top = 0 + TopPanel.Height
    Grid1.Left = 0
    Grid1.Width = ScaleWidth
    Grid1.Height = ScaleHeight - TopPanel.Height - LowerPanel.Height
    End If
End Sub

Sub Grid1_KeyDown (KeyCode As Integer, Shift As Integer)
    Dim CheckRow%
    Dim Pointer%
    Dim ColFlag%
    Dim Counter%
    Dim SaveCol%
    On Error GoTo Grid1KeyDownError:

    Select Case KeyCode
    Case 13, 27
        KeyCode = 0
    Case KEY_F2
        SaveEditRow% = Grid1.Row
        SaveEditCol% = Grid1.Col